home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Info-Mac 4
/
Info_Mac IV CD-ROM (Pacific HiTech Inc.)(August 1994).iso
/
Communications
/
General
/
FC to Clipboard 2.0
/
Pascal Source
/
FCCommenter.p
next >
Wrap
Text File
|
1993-12-15
|
1KB
|
70 lines
unit FCCommenter;
interface
procedure Main;
implementation
procedure MyGetFile (var ok: Boolean; var myFile: FSSpec);
var
myReply: StandardFileReply;
myTypes: SFTypeList;
error: OSErr;
begin
StandardGetFile(nil, -1, myTypes, myReply);
ok := myReply.sfGood;
myFile := myReply.sfFile;
end;
procedure MyGetSITC (var hasSITC: boolean; var myFile: FSSpec; var mySITC: Handle);
var
RezRef: Integer;
begin
RezRef := FSpOpenResFile(myFile, 0);
mySITC := Get1Resource('SitC', 0);
if (ResError <> 0) or (mySITC = nil) then
hasSITC := false;
DetachResource(mySITC);
CloseResFile(RezRef);
end;
procedure MyPasteInfo (var mySITC: Handle);
var
noErr, HLen: LongInt;
begin
noErr := ZeroScrap;
HLen := GetHandleSize(mySITC);
noErr := PutScrap(HLen, 'TEXT', mySITC^);
end;
procedure Main;
type
data = string[17];
myData = ^data;
var
ok, hasSITC: Boolean;
myFile: FSSpec;
mySITC: Handle;
myPtr: myData;
noErr: LongInt;
NA: Str255;
begin
MyGetFile(ok, myFile);
if ok then
begin
MyGetSITC(hasSITC, myFile, mySITC);
if hasSITC then
begin
MyPasteInfo(mySITC);
DisposeHandle(mySITC);
end
else
begin
myPtr := myData(NewPtr(17));
myPtr^ := 'No comment found.';
noErr := ZeroScrap;
noErr := PutScrap(17, 'TEXT', Ptr(myPtr));
end;
end;
end;
end.